home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / misc / m2pica.lha / M2Picasso / Txt / picatest15.mod < prev    next >
Encoding:
Text File  |  1994-11-17  |  3.7 KB  |  134 lines
  1. (*******************************************************************************
  2.  : Program.         Picatest15.MOD
  3.  : Author.          Carsten Wartmann (Crazy Video)
  4.  : Address.         Wutzkyallee 83, 12353 Berlin
  5.  : Phone.           030/6614776
  6.  : Version.         0.99
  7.  : Date.            22.Feb.1994
  8.  : Copyright.       PD
  9.  : Language.        Modula-2
  10.  : Compiler.        M2Amiga V4.3d
  11.  : Contents.        15-Bit Demoprogramm.
  12. *******************************************************************************)
  13.  
  14. MODULE PicaTest15 ;
  15.  
  16.  
  17. FROM SYSTEM       IMPORT ADR,ADDRESS,TAG,SHIFT ;
  18.  
  19. FROM UtilityD     IMPORT tagEnd,tagDone ;
  20.  
  21. FROM Arts         IMPORT Assert ;
  22.  
  23. FROM ExecL        IMPORT Forbid,Permit ;
  24.  
  25. FROM DosL         IMPORT Delay ;
  26.  
  27. FROM GraphicsL    IMPORT SetRGB4 ;
  28.  
  29. FROM IntuitionD   IMPORT ScreenPtr ;
  30. FROM IntuitionL   IMPORT ScreenToFront ;
  31.  
  32. FROM RandomNumber IMPORT RND ;
  33.  
  34. FROM VilIntuiSupL IMPORT OpenVillageScreenTagList,CloseVillageScreen,
  35.                          LockVillageScreen,UnLockVillageScreen,
  36.                          VillageRectFill,VillageBlitCopy,WaitVillageBlit,
  37.                          VillageModeRequest ;
  38. FROM VilIntuiSupD IMPORT Set15BitPixel,Line15Bit,Get15FromRGB,
  39.                          VilFillRecord,VilCopyRecord,VilScrCopy,VilScrAnd,VilDstInvert,
  40.                          TavisTags,InvalidID ;
  41.  
  42.  
  43. VAR scr    : ScreenPtr ;
  44.     start  : ADDRESS ;
  45.     col    : LONGINT ;
  46.     mode   : LONGCARD ;
  47.     x,y,ok,
  48.     r,g,b  : LONGINT ;
  49.     tags   : ARRAY [0..40] OF LONGCARD ;
  50.     copy   : VilCopyRecord ;
  51.     fill   : VilFillRecord ;
  52.  
  53.  
  54.  
  55. BEGIN
  56.   mode := VillageModeRequest(TAG(tags,tavisMinDepth,  15,
  57.                                       tavisMaxDepth,  15,
  58.                                            tagDone)) ;
  59.   Assert(mode#InvalidID,ADR("Kein Screenmode gewählt !")) ;
  60.  
  61.   scr := OpenVillageScreenTagList(TAG(tags,tavisScreenModeID,  mode,
  62.                                            tagDone)) ;
  63.   Assert(scr#NIL,ADR("Kann PICASSO Screen nicht öffnen !")) ;
  64.  
  65.   start := LockVillageScreen(scr) ;
  66.  
  67.   FOR b:=0 TO 31 DO
  68.    FOR g:=0 TO 31 DO
  69.     FOR r:=0 TO 31 DO
  70.      Set15BitPixel(scr,r+(b MOD 8)*32,g+(b DIV 8)*32,r,g,b) ;
  71.     END ;
  72.    END ;
  73.   END ;
  74.  
  75.   UnLockVillageScreen(scr) ;
  76.  
  77.   Delay(3*50) ;
  78.  
  79.   FOR x:=0 TO 255 DO
  80.     Line15Bit(scr,RND(scr^.width),RND(scr^.height),
  81.                   RND(scr^.width),RND(scr^.height),RND(32),RND(32),RND(32)) ;
  82.   END ;
  83.  
  84.   Delay(3*50) ;
  85.  
  86.   Forbid() ;
  87.    ScreenToFront(scr) ;
  88.    start := LockVillageScreen(scr) ;
  89.   Permit() ;
  90.  
  91.   FOR y:=0 TO (scr^.height DIV 32) DO
  92.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  93.       copy.scrAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width) * (y*32) + x*32)*2) ;
  94.       copy.dstAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width)
  95.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32)*2) ;
  96.       copy.scrPitch := scr^.width ;
  97.       copy.dstPitch := scr^.width ;
  98.       copy.width    := 32 ;
  99.       copy.height   := 32 ;
  100.       copy.rop      := VilScrCopy ;
  101.  
  102.       ok := VillageBlitCopy(scr,ADR(copy)) ;
  103.       WaitVillageBlit ;
  104.     END ;
  105.   END ;
  106.  
  107.   Delay(3*50) ;
  108.  
  109.   FOR y:=0 TO (scr^.height DIV 32) DO
  110.     FOR x:=0 TO (scr^.width DIV 32)-1 DO
  111.       fill.dstAdr   := ADDRESS(LONGINT(start) + (LONGINT(scr^.width)
  112.                                * RND(scr^.height DIV 32)*32 + RND(scr^.width DIV 32)*32)*2) ;
  113.       fill.dstPitch := scr^.width ;
  114.       fill.width    := 32 ;
  115.       fill.height   := 32 ;
  116.       fill.color    := RND(255)*65536 + RND(255)*256 + RND(255) ; (* Merged RGB*)
  117.  
  118.       ok := VillageRectFill(scr,ADR(fill)) ;
  119.       WaitVillageBlit ;
  120.     END ;
  121.   END ;
  122.  
  123.   UnLockVillageScreen(scr) ;
  124.  
  125.   Delay(5*50) ;
  126.  
  127. CLOSE
  128.   IF scr#NIL THEN
  129.     UnLockVillageScreen(scr) ;
  130.     CloseVillageScreen(scr) ;
  131.   END ;
  132.  
  133. END PicaTest15 .
  134.